home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / trunc.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  2.8 KB  |  101 lines
  1.       subroutine trunc(delnew)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine determines the new transient stepsize by either
  5. c calling terr to estimate the local truncation error, or by checking
  6. c on the number of iterations needed to converge at the last timepoint.
  7. c
  8. c spice version 2g.6  sccsid=cirdat 3/15/83
  9.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  10.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  11. c spice version 2g.6  sccsid=status 3/15/83
  12.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  13.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  14.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  15. c spice version 2g.6  sccsid=flags 3/15/83
  16.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  17.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  18. c spice version 2g.6  sccsid=tran 3/15/83
  19.       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
  20. c spice version 2g.6  sccsid=blank 3/15/83
  21.       common /blank/ value(200000)
  22.       integer nodplc(64)
  23.       complex cvalue(32)
  24.       equivalence (value(1),nodplc(1),cvalue(1))
  25. c
  26. c
  27.       if (lvltim.ne.0) go to 5
  28.       delnew=dmin1(tstep,delmax)
  29.       return
  30.     5 if (lvltim.ne.1) go to 10
  31.       delnew=delta
  32.       if (iterno.gt.itl3) return
  33.       delnew=dmin1(2.0d0*delta,tstep,delmax)
  34.       return
  35. c
  36. c  capacitors
  37. c
  38.    10 delnew=1.0d20
  39.       loc=locate(2)
  40.    20 if ((loc.eq.0).or.(nodplc(loc+12).ne.0)) go to 30
  41.       loct=nodplc(loc+8)
  42.       call terr(loct,delnew)
  43.       loc=nodplc(loc)
  44.       go to 20
  45. c
  46. c  inductors
  47. c
  48.    30 loc=locate(3)
  49.    40 if ((loc.eq.0).or.(nodplc(loc+14).ne.0)) go to 50
  50.       loct=nodplc(loc+11)
  51.       call terr(loct,delnew)
  52.       loc=nodplc(loc)
  53.       go to 40
  54. c
  55. c  diodes
  56. c
  57.    50 loc=locate(11)
  58.    60 if ((loc.eq.0).or.(nodplc(loc+16).ne.0)) go to 70
  59.       loct=nodplc(loc+11)
  60.       call terr(loct+3,delnew)
  61.       loc=nodplc(loc)
  62.       go to 60
  63. c
  64. c  bjts
  65. c
  66.    70 loc=locate(12)
  67.    80 if ((loc.eq.0).or.(nodplc(loc+36).ne.0)) go to 90
  68.       loct=nodplc(loc+22)
  69.       call terr(loct+8,delnew)
  70.       call terr(loct+10,delnew)
  71.       call terr(loct+12,delnew)
  72.       loc=nodplc(loc)
  73.       go to 80
  74. c
  75. c  jfets
  76. c
  77.    90 loc=locate(13)
  78.   100 if ((loc.eq.0).or.(nodplc(loc+25).ne.0)) go to 110
  79.       loct=nodplc(loc+19)
  80.       call terr(loct+9,delnew)
  81.       call terr(loct+11,delnew)
  82.       loc=nodplc(loc)
  83.       go to 100
  84. c
  85. c  mosfets
  86. c
  87.   110 loc=locate(14)
  88.   120 if ((loc.eq.0).or.(nodplc(loc+33).ne.0)) go to 200
  89.       loct=nodplc(loc+26)
  90.       call terr(loct+12,delnew)
  91.       call terr(loct+14,delnew)
  92.       call terr(loct+16,delnew)
  93.       loc=nodplc(loc)
  94.       go to 120
  95. c
  96. c  delta is allowed only to double at each timepoint
  97. c
  98.   200 delnew=dmin1(2.0d0*delta,delnew,delmax)
  99.       return
  100.       end
  101.